home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CD ROM Paradise Collection 4
/
CD ROM Paradise Collection 4 1995 Nov.iso
/
os2
/
adaptor.zip
/
ADAPT.ZIP
/
adaptor
/
examples
/
dalib
/
cshift
/
test4.f
< prev
next >
Wrap
Text File
|
1993-03-23
|
3KB
|
116 lines
program shift_test
parameter (n=15)
real a(n,n,n,n), b(n,n,n,n)
call cmf_random (b)
call test (a,b,n, 1, 1)
call test (a,b,n, 1, -1)
call test (a,b,n, 1, 49)
call test (a,b,n, 1, 51)
call test (a,b,n, 1, -51)
call test (a,b,n, 1, 13)
call test1 (a,b,n, 1, 1)
call test1 (a,b,n, 1, -1)
call test1 (a,b,n, 1, 49)
call test1 (a,b,n, 1, 51)
call test1 (a,b,n, 1, -51)
call test1 (a,b,n, 1, 13)
call test (a,b,n, 2, 1)
call test (a,b,n, 2, -1)
call test (a,b,n, 2, 49)
call test (a,b,n, 2, 51)
call test (a,b,n, 2, -51)
call test (a,b,n, 2, 13)
call test1 (a,b,n, 2, 1)
call test1 (a,b,n, 2, -1)
call test1 (a,b,n, 2, 49)
call test1 (a,b,n, 2, 51)
call test1 (a,b,n, 2, -51)
call test1 (a,b,n, 2, 13)
call test (a,b,n, 3, 1)
call test (a,b,n, 3, -1)
call test (a,b,n, 3, 49)
call test (a,b,n, 3, 51)
call test (a,b,n, 3, -51)
call test (a,b,n, 3, 13)
call test1 (a,b,n, 3, 1)
call test1 (a,b,n, 3, -1)
call test1 (a,b,n, 3, 49)
call test1 (a,b,n, 3, 51)
call test1 (a,b,n, 3, -51)
call test1 (a,b,n, 3, 13)
call test (a,b,n, 4, 1)
call test (a,b,n, 4, -1)
call test (a,b,n, 4, 49)
call test (a,b,n, 4, 51)
call test (a,b,n, 4, -51)
call test (a,b,n, 4, 13)
call test1 (a,b,n, 4, 1)
call test1 (a,b,n, 4, -1)
call test1 (a,b,n, 4, 49)
call test1 (a,b,n, 4, 51)
call test1 (a,b,n, 4, -51)
call test1 (a,b,n, 4, 13)
end
subroutine test (a, b, n, dim, pos)
integer n, dim
real a(n,n,n,n), b(n,n,n,n)
logical equal (n,n,n,n)
integer pos
integer errors
a = b
b = cshift (b, dim, pos)
if (pos .gt. 0) then
do i = 1, pos
a = cshift (a, dim, 1)
end do
end if
if (pos .lt. 0) then
do i = 1, -pos
a = cshift (a, dim, -1)
end do
end if
equal = (b .eq. a)
errors = count (equal)
errors = n*n*n*n - errors
print *, errors, ' Errors for one shift in dim', dim,' with pos = ', pos
end
subroutine test1 (a, b, n, dim, pos)
integer n, dim
real a(n,n,n,n), b(n,n,n,n)
logical equal (n,n,n,n)
integer pos
integer errors
a = b
do i = 1, n
a = cshift (a, dim, pos)
end do
equal = (b .eq. a)
errors = count (equal)
errors = n*n*n*n - errors
print *, errors, ' Errors for many shift in dim', dim,' with pos = ', pos
end